home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jbindtext.tcl < prev    next >
Encoding:
Text File  |  1995-02-09  |  5.9 KB  |  183 lines
  1. # jbindtext.tcl - support for Text bindings
  2. # 
  3. # Copyright 1992-1994 by Jay Sekora.  All rights reserved, except 
  4. # that this file may be freely redistributed in whole or in part 
  5. # for non-profit, noncommercial use.
  6.  
  7. ######################################################################
  8. ######################################################################
  9. # NOTE : this library is heavily dependent on jtext.tcl as a wrapper
  10. # around the widget commands
  11. ######################################################################
  12. ######################################################################
  13.  
  14.  
  15. ######################################################################
  16. # j:selection_if_any - return selection if it exists, else {}
  17. #   this is from kjx@comp.vuw.ac.nz (R. James Noble)
  18. #   defined elsewhere, but copied here so the bindings libraries
  19. #   don't depend on jtkutils
  20. ######################################################################
  21.  
  22. if {[info procs j:selection_if_any] == {}} {
  23.   proc j:selection_if_any {} {
  24.     if {[catch {selection get} s]} {return ""} {return $s}
  25.   }
  26. }
  27.  
  28. ######################################################################
  29. ####
  30. ###  GENERAL BINDING ROUTINES
  31. ####
  32. ######################################################################
  33.  
  34. ######################################################################
  35. # j:tb:init - initialise info for bindings
  36. ######################################################################
  37.  
  38. proc j:tb:init { {t Text} } {
  39.   global J_PREFS env
  40.   if {! [info exists J_PREFS(typeover)]} {set J_PREFS(typeover) 1}
  41.   switch -exact $J_PREFS(bindings) {
  42.     basic {
  43.       j:tb:basic_init $t
  44.     }
  45.     emacs {
  46.       j:tb:emacs_init $t
  47.     }
  48.     edt {
  49.       j:tb:edt_init $t
  50.     }
  51.     vi {
  52.       j:tb:vi_init $t
  53.     }
  54.   }
  55.  
  56.   # read in user's supplementary text bindings
  57.   j:source_config textbindings.tcl
  58. }
  59.  
  60. ######################################################################
  61. # j:tb:no_op - do nothing
  62. ######################################################################
  63.  
  64. proc j:tb:no_op { args } {
  65.   return 0
  66. }
  67.  
  68. ######################################################################
  69. # j:tb:beep W - beep
  70. ######################################################################
  71.  
  72. proc j:tb:beep { W args } {
  73.   j:beep $W
  74.   return 0
  75. }
  76.  
  77. ######################################################################
  78. # j:tb:move W index - move, possibly clearing selection and resetting state
  79. ######################################################################
  80.  
  81. proc j:tb:move { W index } {
  82.   global J_PREFS
  83.   
  84.   if $J_PREFS(typeover) {
  85.     # clear current selection:
  86.     $W tag remove sel 1.0 end
  87.   }
  88.   j:text:move $W $index
  89. }
  90.  
  91. ######################################################################
  92. # j:tb:clear_selection W - clear the selection in widget W
  93. ######################################################################
  94.  
  95. proc j:tb:clear_selection { W args } {
  96.   $W tag remove sel 1.0 end
  97. }
  98.  
  99. ######################################################################
  100. # j:tb:select_all W - select all text in widget W
  101. ######################################################################
  102.  
  103. proc j:tb:select_all { W args } {
  104.   $W tag add sel 1.0 end
  105. }
  106.  
  107. ######################################################################
  108. # j:tb:is_bol W - return true if insert is at beginning of line
  109. #   from Achim Bohnet <ach@rosat.mpe-garching.mpg.de>
  110. ######################################################################
  111.  
  112. proc j:tb:is_bol { W } {
  113.   return [$W compare insert == "insert linestart"]
  114. }
  115.  
  116. ######################################################################
  117. # j:tb:is_eol W - return true if insert is at end of line
  118. #   from Achim Bohnet <ach@rosat.mpe-garching.mpg.de>
  119. ######################################################################
  120.  
  121. proc j:tb:is_eol { W } {
  122.   return [$W compare insert == "insert lineend"]
  123. }
  124.  
  125. ######################################################################
  126. # j:tb:is_first_line W - return true if insert is on top line
  127. ######################################################################
  128.  
  129. proc j:tb:is_first_line { W } {
  130.   return [$W compare "insert linestart" == 1.0]
  131. }
  132.  
  133. ######################################################################
  134. # j:tb:is_last_line W - return true if insert is on last line
  135. ######################################################################
  136.  
  137. proc j:tb:is_last_line { W } {
  138.   return [$W compare "insert lineend" == end]
  139. }
  140.  
  141. ######################################################################
  142. ######################################################################
  143. # ROUTINES TO SET UP TEXT BINDINGS
  144. ######################################################################
  145. ######################################################################
  146.  
  147. # j:tb:key_bind W - set up bindings to process keys
  148. proc j:tb:key_bind { W args } {
  149.   # get rid of a few default Tk bindings:
  150.   foreach binding {
  151.     <Control-Key-v> <Control-Key-d> <Control-Key-h> <Any-Key>
  152.     <Key-Delete> <Key-BackSpace> <Key-Return>
  153.   } {
  154.     bind $W $binding {}
  155.   }
  156.   # and create null bindings for modifiers, so they don't trigger commands:
  157.   foreach binding {
  158.     <Shift_L> <Shift_R> <Control_L> <Control_R> <Caps_Lock>
  159.     <Shift_Lock> <Meta_L> <Meta_R> <Alt_L> <Alt_R>
  160.   } {
  161.     bind $W $binding { }
  162.   }
  163.   bind $W <Key>            {j:tkb:process_key %W "" %K %A}
  164.   bind $W <Shift-Key>        {j:tkb:process_key %W "" %K %A}
  165.   bind $W <Control-Key>        {j:tkb:process_key %W Control %K %A}
  166.   
  167.   # Compose (Multi_key) key support:
  168.   bind $W <Multi_key>        { }
  169.   bind $W <Multi_key><Any-Key>    {j:tc:start_sequence %W %K %A}
  170.   bind $W <Multi_key><Any-Key><Any-Key> \
  171.                   {j:tc:finish_sequence %W %K %A}
  172.   bind $W <Multi_key><Any-KeyRelease><Any-Key> \
  173.                     {j:tc:start_sequence %W %K %A}
  174.   bind $W <Multi_key><Any-Key><Any-Key> \
  175.                   {j:tc:finish_sequence %W %K %A}
  176.   bind $W <Multi_key><Any-Key><Any-KeyRelease><Any-Key> \
  177.                   {j:tc:finish_sequence %W %K %A}
  178.   bind $W <Multi_key><Any-KeyRelease><Any-Key><Any-KeyRelease><Any-Key> \
  179.                   {j:tc:finish_sequence %W %K %A}
  180.  
  181. }
  182.  
  183.